home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / ExtUtils / CBuilder / Platform / Windows.pm < prev   
Encoding:
Perl POD Document  |  2009-06-26  |  20.4 KB  |  733 lines
  1. package ExtUtils::CBuilder::Platform::Windows;
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use File::Basename;
  7. use File::Spec;
  8.  
  9. use ExtUtils::CBuilder::Base;
  10.  
  11. use vars qw($VERSION @ISA);
  12. $VERSION = '0.21';
  13. @ISA = qw(ExtUtils::CBuilder::Base);
  14.  
  15. sub new {
  16.   my $class = shift;
  17.   my $self = $class->SUPER::new(@_);
  18.   my $cf = $self->{config};
  19.  
  20.   # Inherit from an appropriate compiler driver class
  21.   unshift @ISA, "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
  22.  
  23.   return $self;
  24. }
  25.  
  26. sub _compiler_type {
  27.   my $self = shift;
  28.   my $cc = $self->{config}{cc};
  29.  
  30.   return (  $cc =~ /cl(\.exe)?$/ ? 'MSVC'
  31.       : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
  32.       : 'GCC');
  33. }
  34.  
  35. sub split_like_shell {
  36.   # As it turns out, Windows command-parsing is very different from
  37.   # Unix command-parsing.  Double-quotes mean different things,
  38.   # backslashes don't necessarily mean escapes, and so on.  So we
  39.   # can't use Text::ParseWords::shellwords() to break a command string
  40.   # into words.  The algorithm below was bashed out by Randy and Ken
  41.   # (mostly Randy), and there are a lot of regression tests, so we
  42.   # should feel free to adjust if desired.
  43.   
  44.   (my $self, local $_) = @_;
  45.   
  46.   return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
  47.   
  48.   my @argv;
  49.   return @argv unless defined() && length();
  50.   
  51.   my $arg = '';
  52.   my( $i, $quote_mode ) = ( 0, 0 );
  53.   
  54.   while ( $i < length() ) {
  55.     
  56.     my $ch      = substr( $_, $i  , 1 );
  57.     my $next_ch = substr( $_, $i+1, 1 );
  58.     
  59.     if ( $ch eq '\\' && $next_ch eq '"' ) {
  60.       $arg .= '"';
  61.       $i++;
  62.     } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
  63.       $arg .= '\\';
  64.       $i++;
  65.     } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
  66.       $quote_mode = !$quote_mode;
  67.       $arg .= '"';
  68.       $i++;
  69.     } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
  70.           ( $i + 2 == length()  ||
  71.         substr( $_, $i + 2, 1 ) eq ' ' )
  72.         ) { # for cases like: a"" => [ 'a' ]
  73.       push( @argv, $arg );
  74.       $arg = '';
  75.       $i += 2;
  76.     } elsif ( $ch eq '"' ) {
  77.       $quote_mode = !$quote_mode;
  78.     } elsif ( $ch eq ' ' && !$quote_mode ) {
  79.       push( @argv, $arg ) if $arg;
  80.       $arg = '';
  81.       ++$i while substr( $_, $i + 1, 1 ) eq ' ';
  82.     } else {
  83.       $arg .= $ch;
  84.     }
  85.     
  86.     $i++;
  87.   }
  88.   
  89.   push( @argv, $arg ) if defined( $arg ) && length( $arg );
  90.   return @argv;
  91. }
  92.  
  93. sub arg_defines {
  94.   my ($self, %args) = @_;
  95.   s/"/\\"/g foreach values %args;
  96.   return map qq{"-D$_=$args{$_}"}, keys %args;
  97. }
  98.  
  99. sub compile {
  100.   my ($self, %args) = @_;
  101.   my $cf = $self->{config};
  102.  
  103.   die "Missing 'source' argument to compile()" unless defined $args{source};
  104.  
  105.   my ($basename, $srcdir) =
  106.     ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
  107.  
  108.   $srcdir ||= File::Spec->curdir();
  109.  
  110.   my @defines = $self->arg_defines( %{ $args{defines} || {} } );
  111.  
  112.   my %spec = (
  113.     srcdir      => $srcdir,
  114.     builddir    => $srcdir,
  115.     basename    => $basename,
  116.     source      => $args{source},
  117.     output      => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
  118.     cc          => $cf->{cc},
  119.     cflags      => [
  120.                      $self->split_like_shell($cf->{ccflags}),
  121.                      $self->split_like_shell($cf->{cccdlflags}),
  122.                      $self->split_like_shell($cf->{extra_compiler_flags}),
  123.                    ],
  124.     optimize    => [ $self->split_like_shell($cf->{optimize})    ],
  125.     defines     => \@defines,
  126.     includes    => [ @{$args{include_dirs} || []} ],
  127.     perlinc     => [
  128.                      $self->perl_inc(),
  129.                      $self->split_like_shell($cf->{incpath}),
  130.                    ],
  131.     use_scripts => 1, # XXX provide user option to change this???
  132.   );
  133.  
  134.   $self->normalize_filespecs(
  135.     \$spec{source},
  136.     \$spec{output},
  137.      $spec{includes},
  138.      $spec{perlinc},
  139.   );
  140.  
  141.   my @cmds = $self->format_compiler_cmd(%spec);
  142.   while ( my $cmd = shift @cmds ) {
  143.     $self->do_system( @$cmd )
  144.       or die "error building $cf->{dlext} file from '$args{source}'";
  145.   }
  146.  
  147.   (my $out = $spec{output}) =~ tr/'"//d;
  148.   return $out;
  149. }
  150.  
  151. sub need_prelink { 1 }
  152.  
  153. sub link {
  154.   my ($self, %args) = @_;
  155.   my $cf = $self->{config};
  156.  
  157.   my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
  158.   my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
  159.   $to ||= File::Spec->curdir();
  160.  
  161.   (my $file_base = $args{module_name}) =~ s/.*:://;
  162.   my $output = $args{lib_file} ||
  163.     File::Spec->catfile($to, "$file_base.$cf->{dlext}");
  164.  
  165.   # if running in perl source tree, look for libs there, not installed
  166.   my $lddlflags = $cf->{lddlflags};
  167.   my $perl_src = $self->perl_src();
  168.   $lddlflags =~ s/\Q$cf->{archlibexp}\E[\\\/]CORE/$perl_src/ if $perl_src;
  169.  
  170.   my %spec = (
  171.     srcdir        => $to,
  172.     builddir      => $to,
  173.     startup       => [ ],
  174.     objects       => \@objects,
  175.     libs          => [ ],
  176.     output        => $output,
  177.     ld            => $cf->{ld},
  178.     libperl       => $cf->{libperl},
  179.     perllibs      => [ $self->split_like_shell($cf->{perllibs})  ],
  180.     libpath       => [ $self->split_like_shell($cf->{libpth})    ],
  181.     lddlflags     => [ $self->split_like_shell($lddlflags) ],
  182.     other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
  183.     use_scripts   => 1, # XXX provide user option to change this???
  184.   );
  185.  
  186.   unless ( $spec{basename} ) {
  187.     ($spec{basename} = $args{module_name}) =~ s/.*:://;
  188.   }
  189.  
  190.   $spec{srcdir}   = File::Spec->canonpath( $spec{srcdir}   );
  191.   $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
  192.  
  193.   $spec{output}    ||= File::Spec->catfile( $spec{builddir},
  194.                                             $spec{basename}  . '.'.$cf->{dlext}   );
  195.   $spec{manifest}  ||= File::Spec->catfile( $spec{builddir},
  196.                                             $spec{basename}  . '.'.$cf->{dlext}.'.manifest');
  197.   $spec{implib}    ||= File::Spec->catfile( $spec{builddir},
  198.                                             $spec{basename}  . $cf->{lib_ext} );
  199.   $spec{explib}    ||= File::Spec->catfile( $spec{builddir},
  200.                                             $spec{basename}  . '.exp'  );
  201.   if ($cf->{cc} eq 'cl') {
  202.     $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
  203.                                             $spec{basename}  . '.pdb'  );
  204.   }
  205.   elsif ($cf->{cc} eq 'bcc32') {
  206.     $spec{dbg_file}  ||= File::Spec->catfile( $spec{builddir},
  207.                                             $spec{basename}  . '.tds'  );
  208.   }
  209.   $spec{def_file}  ||= File::Spec->catfile( $spec{srcdir}  ,
  210.                                             $spec{basename}  . '.def'  );
  211.   $spec{base_file} ||= File::Spec->catfile( $spec{srcdir}  ,
  212.                                             $spec{basename}  . '.base' );
  213.  
  214.   $self->add_to_cleanup(
  215.     grep defined,
  216.     @{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]}
  217.   );
  218.  
  219.   foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) {
  220.     $self->normalize_filespecs( \$spec{$opt} );
  221.   }
  222.  
  223.   foreach my $opt ( qw(libpath startup objects) ) {
  224.     $self->normalize_filespecs( $spec{$opt} );
  225.   }
  226.  
  227.   (my $def_base = $spec{def_file}) =~ tr/'"//d;
  228.   $def_base =~ s/\.def$//;
  229.   $self->prelink( dl_name => $args{module_name},
  230.                   dl_file => $def_base,
  231.                   dl_base => $spec{basename} );
  232.  
  233.   my @cmds = $self->format_linker_cmd(%spec);
  234.   while ( my $cmd = shift @cmds ) {
  235.     $self->do_system( @$cmd );
  236.   }
  237.  
  238.   $spec{output} =~ tr/'"//d;
  239.   return wantarray
  240.     ? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]}
  241.     : $spec{output};
  242. }
  243.  
  244. # canonize & quote paths
  245. sub normalize_filespecs {
  246.   my ($self, @specs) = @_;
  247.   foreach my $spec ( grep defined, @specs ) {
  248.     if ( ref $spec eq 'ARRAY') {
  249.       $self->normalize_filespecs( map {\$_} grep defined, @$spec )
  250.     } elsif ( ref $spec eq 'SCALAR' ) {
  251.       $$spec =~ tr/"//d if $$spec;
  252.       next unless $$spec;
  253.       $$spec = '"' . File::Spec->canonpath($$spec) . '"';
  254.     } elsif ( ref $spec eq '' ) {
  255.       $spec = '"' . File::Spec->canonpath($spec) . '"';
  256.     } else {
  257.       die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
  258.     }
  259.   }
  260. }
  261.  
  262. # directory of perl's include files
  263. sub perl_inc {
  264.   my $self = shift;
  265.  
  266.   my $perl_src = $self->perl_src();
  267.  
  268.   if ($perl_src) {
  269.     File::Spec->catdir($perl_src, "lib", "CORE");
  270.   } else {
  271.     File::Spec->catdir($self->{config}{archlibexp},"CORE");
  272.   }
  273. }
  274.  
  275. 1;
  276.  
  277. ########################################################################
  278.  
  279. =begin comment
  280.  
  281. The packages below implement functions for generating properly
  282. formatted commandlines for the compiler being used. Each package
  283. defines two primary functions 'format_linker_cmd()' &
  284. 'format_compiler_cmd()' that accepts a list of named arguments (a
  285. hash) and returns a list of formatted options suitable for invoking the
  286. compiler. By default, if the compiler supports scripting of its
  287. operation then a script file is built containing the options while
  288. those options are removed from the commandline, and a reference to the
  289. script is pushed onto the commandline in their place. Scripting the
  290. compiler in this way helps to avoid the problems associated with long
  291. commandlines under some shells.
  292.  
  293. =end comment
  294.  
  295. =cut
  296.  
  297. ########################################################################
  298. package ExtUtils::CBuilder::Platform::Windows::MSVC;
  299.  
  300. sub format_compiler_cmd {
  301.   my ($self, %spec) = @_;
  302.  
  303.   foreach my $path ( @{ $spec{includes} || [] },
  304.                      @{ $spec{perlinc}  || [] } ) {
  305.     $path = '-I' . $path;
  306.   }
  307.  
  308.   %spec = $self->write_compiler_script(%spec)
  309.     if $spec{use_scripts};
  310.  
  311.   return [ grep {defined && length} (
  312.     $spec{cc},'-nologo','-c',
  313.     @{$spec{includes}}      ,
  314.     @{$spec{cflags}}        ,
  315.     @{$spec{optimize}}      ,
  316.     @{$spec{defines}}       ,
  317.     @{$spec{perlinc}}       ,
  318.     "-Fo$spec{output}"      ,
  319.     $spec{source}           ,
  320.   ) ];
  321. }
  322.  
  323. sub write_compiler_script {
  324.   my ($self, %spec) = @_;
  325.  
  326.   my $script = File::Spec->catfile( $spec{srcdir},
  327.                                     $spec{basename} . '.ccs' );
  328.  
  329.   $self->add_to_cleanup($script);
  330.   print "Generating script '$script'\n" if !$self->{quiet};
  331.  
  332.   open( SCRIPT, ">$script" )
  333.     or die( "Could not create script '$script': $!" );
  334.  
  335.   print SCRIPT join( "\n",
  336.     map { ref $_ ? @{$_} : $_ }
  337.     grep defined,
  338.     delete(
  339.       @spec{ qw(includes cflags optimize defines perlinc) } )
  340.   );
  341.  
  342.   close SCRIPT;
  343.  
  344.   push @{$spec{includes}}, '@"' . $script . '"';
  345.  
  346.   return %spec;
  347. }
  348.  
  349. sub format_linker_cmd {
  350.   my ($self, %spec) = @_;
  351.   my $cf = $self->{config};
  352.  
  353.   foreach my $path ( @{$spec{libpath}} ) {
  354.     $path = "-libpath:$path";
  355.   }
  356.  
  357.   my $output = $spec{output};
  358.  
  359.   $spec{def_file}  &&= '-def:'      . $spec{def_file};
  360.   $spec{output}    &&= '-out:'      . $spec{output};
  361.   $spec{manifest}  &&= '-manifest ' . $spec{manifest};
  362.   $spec{implib}    &&= '-implib:'   . $spec{implib};
  363.   $spec{map_file}  &&= '-map:'      . $spec{map_file};
  364.  
  365.   %spec = $self->write_linker_script(%spec)
  366.     if $spec{use_scripts};
  367.  
  368.   my @cmds; # Stores the series of commands needed to build the module.
  369.  
  370.   push @cmds, [ grep {defined && length} (
  371.     $spec{ld}               ,
  372.     @{$spec{lddlflags}}     ,
  373.     @{$spec{libpath}}       ,
  374.     @{$spec{other_ldflags}} ,
  375.     @{$spec{startup}}       ,
  376.     @{$spec{objects}}       ,
  377.     $spec{map_file}         ,
  378.     $spec{libperl}          ,
  379.     @{$spec{perllibs}}      ,
  380.     $spec{def_file}         ,
  381.     $spec{implib}           ,
  382.     $spec{output}           ,
  383.   ) ];
  384.  
  385.   # Embed the manifest file for VC 2005 (aka VC 8) or higher, but not for the 64-bit Platform SDK compiler
  386.   if ($cf->{ivsize} == 4 && $cf->{cc} eq 'cl' and $cf->{ccversion} =~ /^(\d+)/ and $1 >= 14) {
  387.     push @cmds, [
  388.       'mt', '-nologo', $spec{manifest}, '-outputresource:' . "$output;2"
  389.     ];
  390.   }
  391.  
  392.   return @cmds;
  393. }
  394.  
  395. sub write_linker_script {
  396.   my ($self, %spec) = @_;
  397.  
  398.   my $script = File::Spec->catfile( $spec{srcdir},
  399.                                     $spec{basename} . '.lds' );
  400.  
  401.   $self->add_to_cleanup($script);
  402.  
  403.   print "Generating script '$script'\n" if !$self->{quiet};
  404.  
  405.   open( SCRIPT, ">$script" )
  406.     or die( "Could not create script '$script': $!" );
  407.  
  408.   print SCRIPT join( "\n",
  409.     map { ref $_ ? @{$_} : $_ }
  410.     grep defined,
  411.     delete(
  412.       @spec{ qw(lddlflags libpath other_ldflags
  413.                 startup objects libperl perllibs
  414.                 def_file implib map_file)            } )
  415.   );
  416.  
  417.   close SCRIPT;
  418.  
  419.   push @{$spec{lddlflags}}, '@"' . $script . '"';
  420.  
  421.   return %spec;
  422. }
  423.  
  424. 1;
  425.  
  426. ########################################################################
  427. package ExtUtils::CBuilder::Platform::Windows::BCC;
  428.  
  429. sub format_compiler_cmd {
  430.   my ($self, %spec) = @_;
  431.  
  432.   foreach my $path ( @{ $spec{includes} || [] },
  433.                      @{ $spec{perlinc}  || [] } ) {
  434.     $path = '-I' . $path;
  435.   }
  436.  
  437.   %spec = $self->write_compiler_script(%spec)
  438.     if $spec{use_scripts};
  439.  
  440.   return [ grep {defined && length} (
  441.     $spec{cc}, '-c'         ,
  442.     @{$spec{includes}}      ,
  443.     @{$spec{cflags}}        ,
  444.     @{$spec{optimize}}      ,
  445.     @{$spec{defines}}       ,
  446.     @{$spec{perlinc}}       ,
  447.     "-o$spec{output}"       ,
  448.     $spec{source}           ,
  449.   ) ];
  450. }
  451.  
  452. sub write_compiler_script {
  453.   my ($self, %spec) = @_;
  454.  
  455.   my $script = File::Spec->catfile( $spec{srcdir},
  456.                                     $spec{basename} . '.ccs' );
  457.  
  458.   $self->add_to_cleanup($script);
  459.  
  460.   print "Generating script '$script'\n" if !$self->{quiet};
  461.  
  462.   open( SCRIPT, ">$script" )
  463.     or die( "Could not create script '$script': $!" );
  464.  
  465.   # XXX Borland "response files" seem to be unable to accept macro
  466.   # definitions containing quoted strings. Escaping strings with
  467.   # backslash doesn't work, and any level of quotes are stripped. The
  468.   # result is is a floating point number in the source file where a
  469.   # string is expected. So we leave the macros on the command line.
  470.   print SCRIPT join( "\n",
  471.     map { ref $_ ? @{$_} : $_ }
  472.     grep defined,
  473.     delete(
  474.       @spec{ qw(includes cflags optimize perlinc) } )
  475.   );
  476.  
  477.   close SCRIPT;
  478.  
  479.   push @{$spec{includes}}, '@"' . $script . '"';
  480.  
  481.   return %spec;
  482. }
  483.  
  484. sub format_linker_cmd {
  485.   my ($self, %spec) = @_;
  486.  
  487.   foreach my $path ( @{$spec{libpath}} ) {
  488.     $path = "-L$path";
  489.   }
  490.  
  491.   push( @{$spec{startup}}, 'c0d32.obj' )
  492.     unless ( $spec{starup} && @{$spec{startup}} );
  493.  
  494.   %spec = $self->write_linker_script(%spec)
  495.     if $spec{use_scripts};
  496.  
  497.   return [ grep {defined && length} (
  498.     $spec{ld}               ,
  499.     @{$spec{lddlflags}}     ,
  500.     @{$spec{libpath}}       ,
  501.     @{$spec{other_ldflags}} ,
  502.     @{$spec{startup}}       ,
  503.     @{$spec{objects}}       , ',',
  504.     $spec{output}           , ',',
  505.     $spec{map_file}         , ',',
  506.     $spec{libperl}          ,
  507.     @{$spec{perllibs}}      , ',',
  508.     $spec{def_file}
  509.   ) ];
  510. }
  511.  
  512. sub write_linker_script {
  513.   my ($self, %spec) = @_;
  514.  
  515.   # To work around Borlands "unique" commandline syntax,
  516.   # two scripts are used:
  517.  
  518.   my $ld_script = File::Spec->catfile( $spec{srcdir},
  519.                                        $spec{basename} . '.lds' );
  520.   my $ld_libs   = File::Spec->catfile( $spec{srcdir},
  521.                                        $spec{basename} . '.lbs' );
  522.  
  523.   $self->add_to_cleanup($ld_script, $ld_libs);
  524.  
  525.   print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
  526.  
  527.   # Script 1: contains options & names of object files.
  528.   open( LD_SCRIPT, ">$ld_script" )
  529.     or die( "Could not create linker script '$ld_script': $!" );
  530.  
  531.   print LD_SCRIPT join( " +\n",
  532.     map { @{$_} }
  533.     grep defined,
  534.     delete(
  535.       @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
  536.   );
  537.  
  538.   close LD_SCRIPT;
  539.  
  540.   # Script 2: contains name of libs to link against.
  541.   open( LD_LIBS, ">$ld_libs" )
  542.     or die( "Could not create linker script '$ld_libs': $!" );
  543.  
  544.   print LD_LIBS join( " +\n",
  545.      (delete $spec{libperl}  || ''),
  546.     @{delete $spec{perllibs} || []},
  547.   );
  548.  
  549.   close LD_LIBS;
  550.  
  551.   push @{$spec{lddlflags}}, '@"' . $ld_script  . '"';
  552.   push @{$spec{perllibs}},  '@"' . $ld_libs    . '"';
  553.  
  554.   return %spec;
  555. }
  556.  
  557. 1;
  558.  
  559. ########################################################################
  560. package ExtUtils::CBuilder::Platform::Windows::GCC;
  561.  
  562. sub format_compiler_cmd {
  563.   my ($self, %spec) = @_;
  564.  
  565.   foreach my $path ( @{ $spec{includes} || [] },
  566.                      @{ $spec{perlinc}  || [] } ) {
  567.     $path = '-I' . $path;
  568.   }
  569.  
  570.   # split off any -arguments included in cc
  571.   my @cc = split / (?=-)/, $spec{cc};
  572.  
  573.   return [ grep {defined && length} (
  574.     @cc, '-c'               ,
  575.     @{$spec{includes}}      ,
  576.     @{$spec{cflags}}        ,
  577.     @{$spec{optimize}}      ,
  578.     @{$spec{defines}}       ,
  579.     @{$spec{perlinc}}       ,
  580.     '-o', $spec{output}     ,
  581.     $spec{source}           ,
  582.   ) ];
  583. }
  584.  
  585. sub format_linker_cmd {
  586.   my ($self, %spec) = @_;
  587.  
  588.   # The Config.pm variable 'libperl' is hardcoded to the full name
  589.   # of the perl import library (i.e. 'libperl56.a'). GCC will not
  590.   # find it unless the 'lib' prefix & the extension are stripped.
  591.   $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
  592.  
  593.   unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
  594.     if ( $spec{startup} && @{$spec{startup}} );
  595.  
  596.   # From ExtUtils::MM_Win32:
  597.   #
  598.   ## one thing for GCC/Mingw32:
  599.   ## we try to overcome non-relocateable-DLL problems by generating
  600.   ##    a (hopefully unique) image-base from the dll's name
  601.   ## -- BKS, 10-19-1999
  602.   File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
  603.   $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
  604.  
  605.   %spec = $self->write_linker_script(%spec)
  606.     if $spec{use_scripts};
  607.  
  608.   foreach my $path ( @{$spec{libpath}} ) {
  609.     $path = "-L$path";
  610.   }
  611.  
  612.   my @cmds; # Stores the series of commands needed to build the module.
  613.  
  614.   push @cmds, [
  615.     'dlltool', '--def'        , $spec{def_file},
  616.                '--output-exp' , $spec{explib}
  617.   ];
  618.  
  619.   # split off any -arguments included in ld
  620.   my @ld = split / (?=-)/, $spec{ld};
  621.  
  622.   push @cmds, [ grep {defined && length} (
  623.     @ld                       ,
  624.     '-o', $spec{output}       ,
  625.     "-Wl,--base-file,$spec{base_file}"   ,
  626.     "-Wl,--image-base,$spec{image_base}" ,
  627.     @{$spec{lddlflags}}       ,
  628.     @{$spec{libpath}}         ,
  629.     @{$spec{startup}}         ,
  630.     @{$spec{objects}}         ,
  631.     @{$spec{other_ldflags}}   ,
  632.     $spec{libperl}            ,
  633.     @{$spec{perllibs}}        ,
  634.     $spec{explib}             ,
  635.     $spec{map_file} ? ('-Map', $spec{map_file}) : ''
  636.   ) ];
  637.  
  638.   push @cmds, [
  639.     'dlltool', '--def'        , $spec{def_file},
  640.                '--output-exp' , $spec{explib},
  641.                '--base-file'  , $spec{base_file}
  642.   ];
  643.  
  644.   push @cmds, [ grep {defined && length} (
  645.     @ld                       ,
  646.     '-o', $spec{output}       ,
  647.     "-Wl,--image-base,$spec{image_base}" ,
  648.     @{$spec{lddlflags}}       ,
  649.     @{$spec{libpath}}         ,
  650.     @{$spec{startup}}         ,
  651.     @{$spec{objects}}         ,
  652.     @{$spec{other_ldflags}}   ,
  653.     $spec{libperl}            ,
  654.     @{$spec{perllibs}}        ,
  655.     $spec{explib}             ,
  656.     $spec{map_file} ? ('-Map', $spec{map_file}) : ''
  657.   ) ];
  658.  
  659.   return @cmds;
  660. }
  661.  
  662. sub write_linker_script {
  663.   my ($self, %spec) = @_;
  664.  
  665.   my $script = File::Spec->catfile( $spec{srcdir},
  666.                                     $spec{basename} . '.lds' );
  667.  
  668.   $self->add_to_cleanup($script);
  669.  
  670.   print "Generating script '$script'\n" if !$self->{quiet};
  671.  
  672.   open( SCRIPT, ">$script" )
  673.     or die( "Could not create script '$script': $!" );
  674.  
  675.   print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
  676.     for @{delete $spec{libpath} || []};
  677.  
  678.   # gcc takes only one startup file, so the first object in startup is
  679.   # specified as the startup file and any others are shifted into the
  680.   # beginning of the list of objects.
  681.   if ( $spec{startup} && @{$spec{startup}} ) {
  682.     print SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
  683.     unshift @{$spec{objects}},
  684.       @{delete $spec{startup} || []};
  685.   }
  686.  
  687.   print SCRIPT 'INPUT(' . join( ',',
  688.     @{delete $spec{objects}  || []}
  689.   ) . ")\n";
  690.  
  691.   print SCRIPT 'INPUT(' . join( ' ',
  692.      (delete $spec{libperl}  || ''),
  693.     @{delete $spec{perllibs} || []},
  694.   ) . ")\n";
  695.  
  696.   close SCRIPT;
  697.  
  698.   push @{$spec{other_ldflags}}, '"' . $script . '"';
  699.  
  700.   return %spec;
  701. }
  702.  
  703. 1;
  704.  
  705. __END__
  706.  
  707. =head1 NAME
  708.  
  709. ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
  710.  
  711. =head1 DESCRIPTION
  712.  
  713. This module implements the Windows-specific parts of ExtUtils::CBuilder.
  714. Most of the Windows-specific stuff has to do with compiling and
  715. linking C code.  Currently we support the 3 compilers perl itself
  716. supports: MSVC, BCC, and GCC.
  717.  
  718. This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
  719. not implemented here will be implemented there.  The interfaces are
  720. defined by the L<ExtUtils::CBuilder> documentation.
  721.  
  722. =head1 AUTHOR
  723.  
  724. Ken Williams <ken@mathforum.org>
  725.  
  726. Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
  727.  
  728. =head1 SEE ALSO
  729.  
  730. perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)
  731.  
  732. =cut
  733.